The aim of this website is to report the ongoing geospatial data analysis for the CCRI’s Agricultural Transition: Heart of South West LEP project. All of the tables and plots shown on this website can also be accessed as individual files HERE. The full R programming code used to perform the work is included in this report, and can be accessed by clicking on the “Code” buttons. If you are unfamiliar with R code, comments (in plain English) have been added to describe the operation of each code block, so it should be possible to follow the methodology.


1. Pillar 1: County-level

This section shows the code and outputs for the analysis of Pillar 1 (P1) payments at county level (for the counties of Cornwall, Devon, Dorset, and Somerset)


1.1 Data import & cleaning

Import and cleaning of the CAP Payments (data source: HERE)

Step 1 - Load code packages and import data

#> 1.1.1 Load libraries 
library(tidyverse) # data munging and analysis
library(sf) # simple features for GIS
library(qgisprocess) # access to QGIS algorithms
library(here) # relative path management for reproducibility
library(lubridate) # for date string manipulation/conversion
library(janitor) # data cleaning functions
library(knitr) # report rendering with rmarkdown
library(ggplot2) # plots and visualisations
library(readxl) # import xls
library(scales) # for plot scale customisation
library(mapproj) # map zoom coords
library(leaflet) # interactive web maps
  
#> 1.1.2 Import data (trimming white space)
#> "RPA" sheet
rpa.1 <- readxl::read_xlsx(here("In", "BPS_Glos", "2020_All_CAP_Search_Results_Data_P14.xlsx"), trim_ws = TRUE, sheet = "RPA")
#> "RPA2" sheet
rpa.2 <- readxl::read_xlsx(here("In", "BPS_Glos", "2020_All_CAP_Search_Results_Data_P14.xlsx"), trim_ws = TRUE, sheet = "RPA2")

Step 2 - Data cleaning and pre-processing

#> 1.1.3 Data cleaning and pre-processing

#> Bind the two RPA tables together (they are split alphabetically by beneficiary name)
db <- rbind(rpa.1, rpa.2)

#> Remove duplicates
db <- db %>% 
  distinct()

#> Remove any empty records where all columns are "NA"
# Following filters rows with at least one column not "NA"
db <- janitor::remove_empty(db, which = "rows")

#> Select only relevant rcolumns
db <- db %>% 
  select("BeneficiaryCode", "PostcodePrefix_F202B", "TownCity_F202C", "Basic payment scheme", "Greening: practices beneficial for climate and environment") |> 
  arrange(desc(`Basic payment scheme`))

Table 1.1.1 Full database on import = 88443 records (all England)

## Rows: 88,443
## Columns: 5
## $ BeneficiaryCode                                              <dbl> NA, NA, N~
## $ PostcodePrefix_F202B                                         <chr> "LN4", "S~
## $ TownCity_F202C                                               <chr> "LINCOLN"~
## $ `Basic payment scheme`                                       <dbl> 1929366.7~
## $ `Greening: practices beneficial for climate and environment` <dbl> 872521.2,~

Table 1.1.2 First 6 rows of database

## # A tibble: 6 x 5
##   BeneficiaryCode PostcodePrefix_F202B TownCity_F202C `Basic payment scheme`
##             <dbl> <chr>                <chr>                           <dbl>
## 1              NA LN4                  LINCOLN                      1929367.
## 2              NA SN2                  SWINDON                      1838669.
## 3              NA CB2                  Cambridge                     975272.
## 4              NA NE71                 WOOLER                        969240.
## 5              NA LN5                  LINCOLN                       875713.
## 6              NA PE38                 DOWNHAM MARKET                847869.
## # ... with 1 more variable:
## #   `Greening: practices beneficial for climate and environment` <dbl>


1.2 Land cover processing

The CAP Payments dataset reports payments at postcode district level, but postcode districts do not conform to administrative boundaries (e.g. counties, district unitary authorities). Our approach is to calculate the area of agricultural land (using Corine land cover data) within each postcode district, and to use this to calculate the P1 payments. For districts which straddle county boundaries, the area of agricultural land both inside and outside of the target county are calculated, and the P1 payments are calculated based on the proportion of agricultural land inside the boundary. Agricultural land cover classes were extracted from the Corine 2018 land cover dataset and used for the agricultural area calculations.

The following geospatial datasets are used for this analysis:
- County boundaries - (OS BoundaryLine)
- Postcode district areas - (OpenDoor Postcode Districts)
- Land Cover data - (Corine 2018)

#> Import county boundaries
#> Import ceremonial counties polygon layer from OS BoundaryLine dataset
counties.gb <- st_read(here("In", "Shape", "Counties_GB_BoundaryLine_2018.shp"), quiet = TRUE)

#> Import postcode district boundary polygon data (source: https://www.opendoorlogistics.com/downloads/)
pcodes.gb <- st_read(here("In", "Shape", "Pcode_Districts_OpenDoor_2017.shp"), quiet = TRUE)

#> Import CORINE 2018 land cover data (polygons)
#> Data source: https://catalogue.ceh.ac.uk/documents/084e0bc6-e67f-4dad-9de6-0c698f60e34d
corine.gb <- st_read(here("In", "Shape", "corine_2018_GB.shp"), quiet = TRUE)
#> Select only agri land classes:
# 211 - Non-irrigated arable land
# 212 - Permanently irrigated land
# 213 - Rice fields
# 221 - Vineyards
# 222 - Fruit trees and berry plantations
# 223 - Olive groves
# 231 - Pastures
# 241 - Annual crops associated with permanent crops
# 242 - Complex cultivation patterns
# 243 - Land principally occupied by agriculture with significant areas of natural vegetation
# 244 - Agro-forestry areas
# 321 - Natural grasslands
agri.land.classes <- c("211", "212", "213", "221", "222", "223", "231", "241", "242", "243", "244", "321")
#> Subset data based on land cover codes
corine.agri <- corine.gb |> 
  select(ID, CODE_18) |> 
  filter(CODE_18 %in% agri.land.classes)




  
#> Export agri data for detailed visual checking in QGIS
#> Remove previous shapefile export
unlink(here("Out", "Tests", "Corine_Agri.shp"))
unlink(here("Out", "Tests", "Corine_Agri.dbf"))
unlink(here("Out", "Tests", "Corine_Agri.prj"))
unlink(here("Out", "Tests", "Corine_Agri.shx"))
st_write(corine.agri, here("Out", "Tests", "Corine_Agri.shp"), quiet = TRUE)

#> Show an example plot of agri land extracted from Corine
#> Get Cornwall boundaries
cornwall.sf <- counties.gb |>
  filter(NAME == "Cornwall")
#> Clip corine.gb to extent of Cornwall
corine.clip <- st_intersection(corine.agri,cornwall.sf)
# 
# #> Previous static map (superseded by Leaflet map)
# #> Plot
# plot0 <- ggplot(data = cornwall.sf) +
#   ggtitle("Agricultural land: Cornwall (extracted from Corine 2018)") +
#   # theme_bw() +
#   geom_sf() +
#   geom_sf(data = corine.clip, fill = "green")
# #> Render on web page
# print(plot0)

Figure 1.2.1 Extent of agricultural land (derived from Corine 2018)

#> This code chunk produces an interactive leafelt map of the SW region with Corine agri land shown

#> Subset counties.gb, selecting only Cornwall (inc Isles of Scilly), Devon, Somerset, and Dorset
#> Will also use this string in Section 1.3 loop
#> Create filter string (get names first!)
counties <- c("Cornwall", "Devon", "Dorset", "Somerset")
#> Create sf object of 4 counties
south.west <- counties.gb |>
  filter(NAME %in% counties)
#> Import clipped (to SW region) dissolved layer of Corine agri
#> Pre-processed in QGIS and imported as process in R takes too long
corine.sw <- st_read(here("In", "Shape", "Corine.sw.clip.diss.shp"), quiet = TRUE)
#> Convert layers to WGS84 for use with Leaflet
south.west <- st_transform(south.west, 4326)
corine.sw <- st_transform(corine.sw, 4326)
#> Create Leaflet map
leaflet() |>
  addPolygons(data = corine.sw, fillOpacity = 0.5, color = "green", stroke = FALSE) |>
  addPolygons(data = south.west, fillOpacity = 0, label = TRUE) |>
  addTiles()

1.3 P1 reduction calculations

With all the required input data in place, P1 reductions at county level can now be computed. A brief overview of the workflow:

  • Step 1: Select the four target counties from the GB county data layer
  • Step 2: Initiate a programming loop based on the counties (i.e. same code block is run for each county in turn)
  • Step 3: Create a spatial layer of postcode districts that spatially intersect with the “active” county
  • Step 4: Create a spatial layer of postcode districts clipped exactly to the extent of the “active” county
  • Step 5: Create a spatial layer of postcode districts clipped exactly to the extent of the “active” county
  • Step 6: Using the Corine data on agricultural land area (prepared in Section 1.2), calculate the agricultural land area totals for intersected postcode district polygons, and clipped postcode district polygons respectively. This gives us two values: 1) the total area of agricultural land in each postcode district, and; 2) the area of agricultural land in each postcode district that is within the active county
  • Step 7: Using the agricultural land area proportions and the P1 reduction figures, calculate the “baseline” value for P1 in 2020 and following years with reductions applied up to and including 2027
  • Step 8: Display output tables and bar plots
  • Step 9: Export output tables and bar plots to CCRI shared drive
#> Create filter string (get names first!)
counties <- c("Cornwall", "Devon", "Dorset", "Somerset")

#> Sequential integer counter (for figure numbers)
i <-0 

#> Initiate loop
for(active_county in counties){
  
#> Loop counter (for table caption number)
i <- i+1

#> Select target county (this will be start of loop)
county <- counties.gb |> 
  filter(NAME == active_county)

#> Select postcode district areas that intersect with active county polygon
pcodes.int <- pcodes.gb[county,]
#> Add area (km2) column
pcodes.int$AreaM2 <- st_area(pcodes.int)
#> Convert from m2 to km2
pcodes.int$AREA_KM2_TOTAL <- pcodes.int$AreaM2 / 1000000
pcodes.int$AREA_KM2_TOTAL <- round(pcodes.int$AREA_KM2_TOTAL, digits = 3)
pcodes.int$AREA_KM2_TOTAL <- as.numeric(pcodes.int$AREA_KM2_TOTAL)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "pcodes.int.shp"))
unlink(here("Out", "Tests", "pcodes.int.dbf"))
unlink(here("Out", "Tests", "pcodes.int.prj"))
unlink(here("Out", "Tests", "pcodes.int.shx"))
st_write(pcodes.int, here("Out", "Tests", "pcodes.int.shp"), quiet = TRUE)


#> Generate a layer of clipped (cookie cutter) postcodes using active county boundary
pcodes.clip <- st_intersection(pcodes.int, county)
#> Add area (km2) column
pcodes.clip$AreaM2 <- st_area(pcodes.clip)
#> Convert from m2 to km2
pcodes.clip$AREA_KM2_CLIP<- pcodes.clip$AreaM2 / 1000000
pcodes.clip$AREA_KM2_CLIP <- round(pcodes.clip$AREA_KM2_CLIP, digits = 3)
pcodes.clip$AREA_KM2_CLIP <- as.numeric(pcodes.clip$AREA_KM2_CLIP)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "pcodes.clip.shp"))
unlink(here("Out", "Tests", "pcodes.clip.dbf"))
unlink(here("Out", "Tests", "pcodes.clip.prj"))
unlink(here("Out", "Tests", "pcodes.clip.shx"))
st_write(pcodes.clip, here("Out", "Tests", "pcodes.clip.shp"), quiet = TRUE)


#> To calculate agri land differences for postcodes which straddle the boundary of target county...
#> 1. Intersect pcodes.int with corine.agri, to calculate area of agri land for all intersecting pcode district polys (whole polygon)
#> 2. Intersect pcodes.clip with corine.int to calculate area of agri land ony within target county polygon
#> 3. Calculate percentage difference between the TWO sets of area calculations to gove % of agri land in each pcode district polygon


#> 1. Intersect pcodes.int with corine.agri, to calculate area of agri land for all intersecting pcode district polys (whole polygon)
agri.int.total <- st_intersection(pcodes.int, corine.agri)
#> Calculate area of Corine agri land
agri.int.total$AREA_AGRI_TOTAL <- st_area(agri.int.total)
#> Convert from m2 to km2
agri.int.total$AREA_AGRI_TOTAL <- agri.int.total$AREA_AGRI_TOTAL / 1000000
agri.int.total$AREA_AGRI_TOTAL <- round(agri.int.total$AREA_AGRI_TOTAL, digits = 3)
agri.int.total$AREA_AGRI_TOTAL <- as.numeric(agri.int.total$AREA_AGRI_TOTAL)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "agri.int.total.shp"))
unlink(here("Out", "Tests", "agri.int.total.dbf"))
unlink(here("Out", "Tests", "agri.int.total.prj"))
unlink(here("Out", "Tests", "agri.int.total.shx"))
st_write(agri.int.total, here("Out", "Tests", "agri.int.total.shp"), quiet = TRUE)
#> Create grouped (by pcode) non-geo version of the table
st_geometry(agri.int.total) <- NULL
agri.int.total <- agri.int.total |> 
  select(name, AREA_AGRI_TOTAL) |> 
  group_by(name) |> 
  summarise(AGRI_TOTAL = sum(AREA_AGRI_TOTAL))


#> 2. Intersect pcodes.clip with corine.int to calculate area of agri land ony within target county polygon
agri.int.clip <- st_intersection(pcodes.clip, corine.agri)
#> Calculate area of Corine agri land
agri.int.clip$AREA_AGRI_CLIP <- st_area(agri.int.clip)
#> Convert from m2 to km2
agri.int.clip$AREA_AGRI_CLIP <- agri.int.clip$AREA_AGRI_CLIP / 1000000
agri.int.clip$AREA_AGRI_CLIP <- round(agri.int.clip$AREA_AGRI_CLIP, digits = 3)
agri.int.clip$AREA_AGRI_CLIP <- as.numeric(agri.int.clip$AREA_AGRI_CLIP)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "agri.int.clip.shp"))
unlink(here("Out", "Tests", "agri.int.clip.dbf"))
unlink(here("Out", "Tests", "agri.int.clip.prj"))
unlink(here("Out", "Tests", "agri.int.clip.shx"))
st_write(agri.int.clip, here("Out", "Tests", "agri.int.clip.shp"), quiet = TRUE)
#> Create grouped (by pcode) non-geo version of the table
st_geometry(agri.int.clip) <- NULL
agri.int.clip <- agri.int.clip |> 
  select(name, AREA_AGRI_CLIP) |> 
  group_by(name) |> 
  summarise(AGRI_CLIP = sum(AREA_AGRI_CLIP))


#> 3. Calculate percentage difference between the two sets of area calculations to gove % of agri land in each pcode district polygon
#> Merge the two data frames to show size of agri area within and outside target county
agri.merge <- merge(agri.int.total, agri.int.clip, by = "name", all.x = TRUE)
#> Round area calcs up to 1 decimal place (to negate effect of small amounts of agri land being lost when clipped)
agri.merge$AGRI_TOTAL <- round(agri.merge$AGRI_TOTAL, digits = 3)
agri.merge$AGRI_CLIP <- round(agri.merge$AGRI_CLIP, digits = 2)
#> Calculate percentage of agri land within target county 
agri.merge$PCENT_AGRI_LAND <- agri.merge$AGRI_CLIP/ agri.merge$AGRI_TOTAL
#> Round up
agri.merge$PCENT_AGRI_LAND <- round(agri.merge$PCENT_AGRI_LAND, digits = 3)



#> Extract postcode districts from the BPS source data ("db") which intersect with the active county polygon boundary
#> Do this via a merge between db and pcodes.int, keeping only matching records in a new data frame
#> Rename pcodes.in and drop geom
pcodes.active <- pcodes.int
st_geometry(pcodes.active) <- NULL
BPS.merge <- merge(db, pcodes.active, by.x = "PostcodePrefix_F202B", "name", all.x = FALSE)
#> Convert all NAs to zeros in data frame
BPS.merge[is.na(BPS.merge)] <- 0



#> BPS Calcs by year

#> 2020
#> Create table with baseline P1 (BPS + Greening) payments by postcode district for 2020 (no reductions applied)
t1.2020 <- BPS.merge %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2020_Baseline = sum(`Basic payment scheme`) + sum(`Greening: practices beneficial for climate and environment`))
#> Check sum total of P1 for reference
sum.original.p1 <- sum(t1.2020$P1_2020_Baseline)
#> Merge with agri.merge data frame to append 2020 calcs and create new master table "t1"
t1 <- merge(t1.2020, agri.merge, by.x = "PostcodePrefix_F202B", by.y = "name")
#> #> Calculate P1 payment based on area of agri land within each postcode area
t1$P1_2020 <- t1$P1_2020_Baseline * t1$PCENT_AGRI_LAND
#> Round to 2 decimal places
t1$P1_2020 <- round(t1$P1_2020, digits = 2)



#> 2021
t1.2021 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2021$P1_2020 <- t1.2021$`Basic payment scheme` + t1.2021$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2021 reductions
t1.2021 <- t1.2021 %>% 
  mutate(P1_2021 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.95,
                              (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.90,
                              (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.80,
                              P1_2020 > 150000 ~ P1_2020 * 0.75))
# Group by postcode an summarise
t1.2021 <- t1.2021 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2021 = sum(P1_2021))
#> Round
t1.2021$P1_2021 <- round(t1.2021$P1_2021, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2021, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2021 <- t1$P1_2021 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2021 <- round(t1$P1_2021, digits = 2)
#> Check sum
sum.p1.2021 <- sum(t1$P1_2021)



#> 2022
t1.2022 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2022$P1_2020 <- t1.2022$`Basic payment scheme` + t1.2022$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2022 reductions
t1.2022 <- t1.2022 %>% 
   mutate(P1_2022 = case_when(P1_2020<=30000 ~ P1_2020* 0.80,
                             (P1_2020>30000 & P1_2020<=50000) ~ P1_2020* 0.75,
                             (P1_2020>50000 & P1_2020<=150000) ~ P1_2020* 0.65,
                             P1_2020> 150000 ~ P1_2020* 0.60))
# Group by postcode an summarise
t1.2022 <- t1.2022 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2022 = sum(P1_2022))
#> Round
t1.2022$P1_2022 <- round(t1.2022$P1_2022, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2022, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2022 <- t1$P1_2022 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2022 <- round(t1$P1_2022, digits = 2)
#> Check sum
sum.p1.2022 <- sum(t1$P1_2022)


#> 2023
t1.2023 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2023$P1_2020 <- t1.2023$`Basic payment scheme` + t1.2023$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2023 reductions
t1.2023 <- t1.2023 %>% 
  mutate(P1_2023 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.65,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.60,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.50,
                             P1_2020 > 150000 ~ P1_2020 * 0.45))
# Group by postcode an summarise
t1.2023 <- t1.2023 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2023 = sum(P1_2023))
#> Round
t1.2023$P1_2023 <- round(t1.2023$P1_2023, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2023, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2023 <- t1$P1_2023 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2023 <- round(t1$P1_2023, digits = 2)
#> Check sum
sum.p1.2023 <- sum(t1$P1_2023)


#> 2024
t1.2024 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2024$P1_2020 <- t1.2024$`Basic payment scheme` + t1.2024$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2024 reductions
t1.2024 <- t1.2024 %>% 
  mutate(P1_2024 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.50,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.45,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.35,
                             P1_2020 > 150000 ~ P1_2020 * 0.30))
# Group by postcode an summarise
t1.2024 <- t1.2024 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2024 = sum(P1_2024))
#> Round
t1.2024$P1_2024 <- round(t1.2024$P1_2024, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2024, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2024 <- t1$P1_2024 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2024 <- round(t1$P1_2024, digits = 2)
#> Check sum
sum.p1.2024 <- sum(t1$P1_2024)


#> 2025
t1.2025 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2025$P1_2020 <- t1.2025$`Basic payment scheme` + t1.2025$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2025 reductions
t1.2025 <- t1.2025 %>% 
 mutate(P1_2025 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.40,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.35,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.25,
                             P1_2020 > 150000 ~ P1_2020 * 0.20))
# Group by postcode an summarise
t1.2025 <- t1.2025 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2025 = sum(P1_2025))
#> Round
t1.2025$P1_2025 <- round(t1.2025$P1_2025, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2025, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2025 <- t1$P1_2025 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2025 <- round(t1$P1_2025, digits = 2)
#> Check sum
sum.p1.2025 <- sum(t1$P1_2025)


#> 2026
t1.2026 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2026$P1_2020 <- t1.2026$`Basic payment scheme` + t1.2026$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2026 reductions
t1.2026 <- t1.2026 %>% 
  mutate(P1_2026 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.25,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.25,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.15,
                             P1_2020 > 150000 ~ P1_2020 * 0.15))
# Group by postcode an summarise
t1.2026 <- t1.2026 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2026 = sum(P1_2026))
#> Round
t1.2026$P1_2026 <- round(t1.2026$P1_2026, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2026, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2026 <- t1$P1_2026 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2026 <- round(t1$P1_2026, digits = 2)
#> Check sum
sum.p1.2026 <- sum(t1$P1_2026)


#> 2027
t1.2027 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2027$P1_2020 <- t1.2027$`Basic payment scheme` + t1.2027$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2027 reductions
t1.2027 <- t1.2027 %>% 
   mutate(P1_2027 = case_when(P1_2020<=30000 ~ P1_2020* 0.15,
                             (P1_2020>30000 & P1_2020<=50000) ~ P1_2020* 0.15,
                             (P1_2020>50000 & P1_2020<=150000) ~ P1_2020* 0.10,
                             P1_2020> 150000 ~ P1_2020* 0.10))
# Group by postcode an summarise
t1.2027 <- t1.2027 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2027 = sum(P1_2027))
#> Round
t1.2027$P1_2027 <- round(t1.2027$P1_2027, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2027, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2027 <- t1$P1_2027 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2027 <- round(t1$P1_2027, digits = 2)
#> Check sum
sum.p1.2027 <- sum(t1$P1_2027)

#> Convert all NAs to zeros in data frame
t1[is.na(t1)] <- 0



#> Create plot

#> P1 payments by year
p1.in <- as.data.frame(colSums(t1[6:13]))
#> Change rownames to column "Value"
p1.plot <- tibble::rownames_to_column(p1.in, "VALUE")
#> Extract year from string
p1.plot$VALUE <- sub("^.*([0-9]{4}).*", "\\1", p1.plot$VALUE)
names(p1.plot)[1]<-paste("Year")
names(p1.plot)[2]<-paste("Value_bps")

#> Print table t1 on web page
print(knitr::kable(t1, col.names = c("PC", "2020_Unadjusted", "Agri_In", "Agri_Out", "Agri_PC", "2020", "2021", "2022", "2023", "2024", "2025", "2026", "2027"), caption = paste0("Table 1.", i , " ", "P1 reductions by postcode district - ",  active_county)))

#> Add line breaks
cat("\n")
cat("\n")
cat("\n")
cat("\n")
cat("\n")
cat("\n")


# Simple bar chart
plot1 <- ggplot(p1.plot, aes(x=Year, y=Value_bps)) + 
  theme_bw() +
  geom_bar(stat = "identity", fill="#2c66b8", width = 0.6) +
  geom_text(aes(label= paste0(round(Value_bps / 1000000, digits = 1), " M")), vjust = 1.5, colour = "white") +
  labs(title = paste0("Pillar 1 reductions:", " ", active_county), x = "Year", y = "Value (£)") +
  theme(plot.title = element_text(hjust = 0.5)) +
  theme(axis.title.y = element_text(margin = margin(t = 0, r = 16, b = 0, l = 0))) +
  theme(axis.title.x = element_text(margin = margin(t = 12, r = 0, b = 0, l = 0))) +
  theme(legend.position="none") +
  scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))
plot1

#> Add line breaks
cat("\n")
cat("\n")
cat("\n")
cat("\n")
cat("\n")
cat("\n")

#> Render on web page
print(plot1)

#> Export the plot
ggsave(here("Out", "P1", "County", "Plot", paste0("P1_Reductions_", active_county, ".png")))

#> Export final t1 table
write_csv(t1, here("Out", "P1", "County", "CSV", paste0("P1_Reductions_", active_county, ".csv")))

}
Table 1.1 P1 reductions by postcode district - Cornwall
PC 2020_Unadjusted Agri_In Agri_Out Agri_PC 2020 2021 2022 2023 2024 2025 2026 2027
EX22 5669306.76 309.280 60.04 0.194 1099845.51 1009289.94 844313.11 679336.28 514359.46 404374.90 259384.85 157188.56
EX23 2746120.50 161.015 155.91 0.968 2658244.64 2452387.98 2053651.28 1654914.59 1256177.89 990353.42 636404.35 384658.29
EX39 4543093.48 217.013 0.11 0.001 4543.09 4080.62 3399.16 2717.70 2036.23 1581.92 1017.41 622.28
PL10 189625.56 9.333 9.33 1.000 189625.56 161357.89 132914.06 104470.22 76026.39 57063.83 34882.13 22181.70
PL11 693638.88 31.060 31.06 1.000 693638.88 590828.92 486783.08 382737.25 278691.42 209327.53 140836.52 87759.23
PL12 1606968.13 97.248 96.39 0.991 1592505.42 1434640.46 1195764.66 956888.85 718013.04 558762.49 356392.72 218008.99
PL13 1346066.02 68.542 68.54 1.000 1346066.02 1224847.81 1022937.90 821028.00 619118.10 484511.50 317521.23 192412.27
PL14 3699213.10 199.621 199.62 1.000 3699213.10 3360619.05 2805737.08 2250855.12 1695973.15 1326051.84 855607.66 520284.16
PL15 6365797.99 323.655 289.60 0.895 5697389.20 5190495.79 4335887.41 3481279.03 2626670.65 2056931.73 1328062.41 806465.94
PL16 777462.94 51.306 0.40 0.008 6219.70 5753.88 4820.93 3887.97 2955.02 2333.05 1514.73 912.86
PL17 1330900.25 82.452 81.32 0.986 1312267.65 1204492.63 1007652.48 810812.33 613972.18 482745.42 311422.91 188518.15
PL18 149813.87 10.966 9.86 0.899 134682.67 127948.54 107746.14 87543.74 67341.34 53873.07 33670.67 20202.40
PL19 2872716.90 143.412 1.02 0.007 20109.02 17907.29 14890.94 11874.58 8858.23 6847.33 4376.04 2690.74
PL20 2201678.08 164.444 0.82 0.005 11008.39 9555.35 7904.09 6252.83 4601.57 3500.73 2241.09 1395.76
PL22 1066944.05 51.502 51.50 1.000 1066944.05 975915.67 815874.06 655832.45 495790.85 389096.44 256291.14 154819.17
PL23 342779.53 18.717 18.71 1.000 342779.53 299483.04 248066.11 196649.18 145232.25 110954.30 71527.08 44333.03
PL24 295252.56 22.745 22.72 0.999 294957.31 278472.22 234228.63 189985.02 145741.43 116245.70 73739.33 44243.59
PL25 102286.28 8.790 8.79 1.000 102286.28 97171.97 81829.02 66486.08 51143.14 40914.51 25571.57 15342.94
PL26 2117478.59 109.572 109.55 1.000 2117478.59 1866270.68 1548648.89 1231027.11 913405.32 701657.46 441685.54 273779.74
PL27 2006347.61 104.429 104.40 1.000 2006347.61 1794473.10 1493520.96 1192568.82 891616.67 690981.91 442622.89 271470.14
PL28 395589.12 27.003 26.96 0.998 394797.94 357752.54 298532.86 239313.16 180093.47 140613.68 88187.79 53963.85
PL29 418500.38 17.702 17.67 0.998 417663.38 365148.36 302498.85 239849.34 177199.83 135433.50 84359.76 52621.47
PL30 4225344.65 216.220 216.21 1.000 4225344.65 3774675.54 3140873.85 2507072.15 1873270.45 1450735.99 921158.70 566212.97
PL31 123129.98 8.036 8.04 1.000 123129.98 114872.48 96402.98 77933.49 59463.99 47150.99 30782.50 18469.50
PL32 1462284.16 77.982 77.98 1.000 1462284.16 1289920.03 1070577.40 851234.78 631892.15 485663.74 309257.44 191185.82
PL33 367946.45 16.134 16.13 1.000 367946.45 341738.88 286546.91 231354.94 176162.98 139368.33 91986.61 55191.97
PL34 194194.17 13.036 13.03 1.000 194194.17 173971.89 144842.76 115713.64 86584.51 67165.09 41540.16 25624.93
PL35 405298.48 24.497 24.48 0.999 404893.18 379023.00 318289.02 257555.05 196821.07 156331.75 101223.30 60733.98
PL5 115480.60 6.203 0.00 0.000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
TR1 150767.81 10.057 10.06 1.000 150767.81 141036.09 118420.92 95805.75 73190.58 58113.80 37691.95 22615.17
TR10 242695.35 22.429 22.43 1.000 242695.35 227005.59 190601.29 154196.98 117792.68 93523.15 60673.84 36404.30
TR11 809918.04 47.771 47.76 1.000 809918.04 739935.50 618447.79 496960.08 375472.38 294480.57 190239.64 115367.77
TR12 2347108.17 120.207 120.11 0.999 2344761.06 2114143.59 1762429.43 1410715.27 1059001.11 824525.00 527904.35 322571.20
TR13 1529143.44 76.348 76.33 1.000 1529143.44 1363864.31 1134492.79 905121.28 675749.76 522835.42 333307.45 204882.31
TR14 570914.31 52.237 52.24 1.000 570914.31 534880.93 449243.79 363606.64 277969.50 220878.06 142728.58 85637.15
TR15 52472.02 5.335 5.34 1.001 52524.49 49898.27 42019.60 34140.92 26262.25 21009.80 13131.13 7878.67
TR16 562427.41 57.361 57.35 1.000 562427.41 517473.13 433109.02 348744.91 264380.80 208138.06 129384.91 78753.14
TR17 31789.87 3.792 3.79 0.999 31758.08 30170.18 25406.47 20642.76 15879.04 12703.23 7939.52 4763.71
TR18 43280.41 2.995 3.00 1.002 43366.97 41198.62 34693.58 28188.53 21683.48 17346.78 10841.74 6505.04
TR19 1255959.76 72.809 72.79 1.000 1255959.76 1134828.39 946434.43 758040.46 569646.50 444050.52 282318.39 172558.19
TR2 3014939.68 158.572 158.50 1.000 3014939.68 2674622.68 2222381.73 1770140.77 1317899.82 1016405.85 650596.61 400671.80
TR20 1844232.47 87.139 87.13 1.000 1844232.47 1655324.13 1378689.26 1102054.39 825419.52 640996.27 401884.76 247048.19
TR21 112278.57 5.625 5.60 0.996 111829.46 97562.55 80788.14 64013.72 47239.30 36056.36 22173.75 13882.61
TR22 2863.23 1.112 1.10 0.989 2831.73 2690.15 2265.38 1840.63 1415.87 1132.69 707.94 424.76
TR23 0.00 0.833 0.83 0.996 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
TR24 15758.29 1.495 1.49 0.997 15711.02 14925.47 12568.81 10212.16 7855.51 6284.41 3927.75 2356.65
TR25 12436.24 1.701 1.69 0.994 12361.62 11743.54 9889.30 8035.06 6180.81 4944.65 3090.41 1854.25
TR26 509676.37 20.354 20.35 1.000 509676.37 462832.82 386381.37 309929.91 233478.46 182510.82 119703.95 72593.89
TR27 1128696.86 56.978 56.97 1.000 1128696.86 993178.89 823874.36 654569.83 485265.30 372395.61 235024.62 145729.73
TR3 777745.65 48.742 48.73 1.000 777745.65 703902.64 587240.79 470578.94 353917.10 276142.53 174426.84 106657.06
TR4 1695773.01 106.658 106.66 1.000 1695773.01 1533393.78 1279027.83 1024661.87 770295.92 600718.62 385095.57 234942.11
TR5 146924.33 12.335 12.33 1.000 146924.33 137698.29 115659.64 93620.99 71582.34 56889.91 36731.08 22038.65
TR6 114737.04 5.302 5.30 1.000 114737.04 101498.14 84287.59 67077.03 49866.48 38392.77 23682.90 14709.87
TR7 0.00 2.474 2.47 0.998 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
TR8 1918497.42 119.637 119.62 1.000 1918497.42 1702684.63 1414910.01 1127135.40 839360.79 647511.05 415615.20 255770.04
TR9 654565.36 39.651 39.65 1.000 654565.36 595145.15 496960.35 398775.54 300590.74 235134.20 149961.52 91344.89

Table 1.2 P1 reductions by postcode district - Devon
PC 2020_Unadjusted Agri_In Agri_Out Agri_PC 2020 2021 2022 2023 2024 2025 2026 2027
DT6 3036994.48 158.966 0.36 0.002 6073.99 5382.63 4471.53 3560.43 2649.33 2041.93 1292.80 798.25
DT7 238968.44 16.753 15.32 0.914 218417.15 192242.36 159479.78 126717.21 93954.64 72112.92 45741.86 28331.36
EX1 194693.43 3.023 3.02 0.999 194498.74 183115.46 153940.65 124765.84 95591.03 76141.15 48624.69 29174.81
EX10 988503.32 52.203 52.20 1.000 988503.32 865341.81 717066.31 568790.81 420515.32 321664.98 211756.34 130590.75
EX11 515375.44 33.269 33.27 1.000 515375.44 464148.89 386842.58 309536.26 232229.94 180692.40 117277.18 71522.98
EX12 475378.22 24.567 24.56 1.000 475378.22 413573.15 342266.42 270959.68 199652.95 152115.13 97410.08 60589.49
EX13 2276377.07 111.911 107.43 0.960 2185321.99 2017742.73 1689944.43 1362146.13 1034347.83 815815.63 521702.15 315484.13
EX14 3584346.54 186.890 186.13 0.996 3570009.15 3288289.19 2752787.82 2217286.45 1681785.07 1324784.15 841566.24 510033.34
EX15 3044385.84 167.143 166.04 0.993 3023075.14 2826972.53 2373511.26 1920049.99 1466588.72 1164281.21 750243.74 450698.75
EX16 6005179.21 325.694 322.95 0.992 5957137.78 5548811.89 4655241.22 3761670.55 2868099.88 2272386.11 1443349.96 870603.42
EX17 5886022.85 293.242 293.24 1.000 5886022.85 5295893.63 4412990.20 3530086.78 2647183.35 2058581.06 1315300.89 804801.02
EX18 1746019.28 103.597 103.60 1.000 1746019.28 1618154.73 1356251.84 1094348.95 832446.06 657844.13 422280.55 254790.76
EX19 1737511.41 94.687 94.69 1.000 1737511.41 1624901.40 1364274.69 1103647.98 843021.27 669270.13 427002.09 256938.83
EX2 573837.75 19.150 19.15 1.000 573837.75 495976.30 409900.64 323824.98 237749.31 180365.54 112993.93 70842.91
EX20 7462904.40 389.425 389.42 1.000 7462904.40 6763333.19 5643897.53 4524461.87 3405026.21 2658735.77 1685950.37 1029547.80
EX21 2399858.70 145.033 145.03 1.000 2399858.70 2236945.26 1876966.45 1516987.65 1157008.84 917022.97 583169.41 351581.17
EX22 5669306.76 309.280 249.23 0.806 4569461.25 4193235.50 3507816.32 2822397.13 2136977.94 1680031.82 1077650.46 653061.77
EX23 2746120.50 161.015 5.11 0.032 87875.86 81070.68 67889.30 54707.92 41526.54 32738.96 21038.16 12715.98
EX24 781691.86 44.070 44.07 1.000 781691.86 728370.10 611116.32 493862.54 376608.76 298439.57 190347.70 114716.14
EX3 116221.08 7.142 7.14 1.000 116221.08 108799.55 91366.39 73933.23 56500.06 44877.96 29055.27 17433.16
EX31 4437568.50 215.235 215.23 1.000 4437568.50 4001220.85 3335585.57 2669950.30 2004315.02 1560558.17 1002774.60 612326.51
EX32 2503991.07 115.188 115.19 1.000 2503991.07 2258849.75 1883251.09 1507652.43 1132053.77 881654.66 562531.22 343865.39
EX33 721810.94 43.430 43.43 1.000 721810.94 643023.10 534751.46 426479.82 318208.18 246027.08 157286.94 96688.75
EX34 1182067.84 69.853 69.85 1.000 1182067.84 1094341.86 917031.69 739721.51 562411.34 444204.55 287578.34 173340.86
EX35 653966.01 54.251 45.86 0.845 552601.28 485439.83 402549.64 319659.44 236769.25 181509.13 114058.81 70844.44
EX36 4654512.01 226.749 216.85 0.956 4449713.48 4023360.26 3355903.24 2688446.22 2020989.20 1576017.85 1007128.87 614807.27
EX37 2107604.22 115.910 115.91 1.000 2107604.22 1961614.56 1645473.93 1329333.30 1013192.67 802432.24 519266.49 312323.35
EX38 1772073.96 93.861 93.86 1.000 1772073.96 1641940.91 1376129.82 1110318.72 844507.63 667300.23 426286.32 257445.01
EX39 4543093.48 217.013 216.85 0.999 4538550.39 4076543.31 3395760.75 2714978.18 2034195.63 1580340.59 1016395.50 621661.51
EX4 345514.09 33.458 33.46 1.000 345514.09 328238.39 276411.27 224584.16 172757.05 138205.64 86378.52 51827.11
EX5 3671497.74 204.035 204.04 1.000 3671497.74 3249242.29 2698517.62 2147792.96 1597068.30 1229918.53 776091.33 479833.11
EX6 2976600.96 172.906 172.91 1.000 2976600.96 2677064.48 2230574.33 1784084.19 1337594.04 1039933.95 674592.36 411711.21
EX7 246386.69 15.807 15.81 1.000 246386.69 234067.36 197109.35 160151.35 123193.34 98554.68 61596.67 36958.00
EX8 160334.56 12.720 12.72 1.000 160334.56 148533.85 124483.67 100433.48 76383.30 60349.84 40083.64 24050.18
EX9 735024.20 18.624 18.61 0.999 734289.18 599222.77 489079.39 378936.01 268792.64 195363.72 133032.00 84873.23
PL10 189625.56 9.333 0.00 0.000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
PL12 1606968.13 97.248 0.86 0.009 14462.71 13029.03 10859.62 8690.21 6520.80 5074.53 3236.66 1979.90
PL15 6365797.99 323.655 34.06 0.105 668408.79 608940.85 508679.53 408418.21 308156.89 241316.01 155806.20 94613.32
PL16 777462.94 51.306 50.91 0.992 771243.24 713481.59 597795.10 482108.61 366422.12 289297.80 187827.07 113194.62
PL17 1330900.25 82.452 1.13 0.014 18632.60 17102.33 14307.44 11512.55 8717.66 6854.40 4421.83 2676.73
PL18 149813.87 10.966 1.10 0.100 14981.39 14232.32 11985.11 9737.90 7490.69 5992.56 3745.35 2247.21
PL19 2872716.90 143.412 142.39 0.993 2852607.88 2540276.71 2112385.53 1684494.35 1256603.17 971342.38 620771.87 381701.14
PL20 2201678.08 164.444 163.62 0.995 2190669.69 1901513.98 1572913.53 1244313.08 915712.63 696645.66 445977.70 277755.59
PL21 1668994.99 102.426 102.43 1.000 1668994.99 1528111.87 1277762.62 1027413.37 777064.12 610164.62 392921.22 238185.48
PL5 115480.60 6.203 6.20 1.000 115480.60 106244.85 88922.76 71600.67 54278.58 42730.52 28870.15 17322.09
PL6 358828.36 11.866 11.87 1.000 358828.36 297562.66 243738.41 189914.16 136089.90 100207.07 67211.32 42576.37
PL7 494378.82 35.743 35.74 1.000 494378.82 446623.20 372466.38 298309.56 224152.73 174714.85 110409.84 67564.39
PL8 1136984.10 49.463 49.40 0.999 1135847.12 969238.94 798861.88 628484.81 458107.74 344523.03 225522.45 141157.40
PL9 282611.66 17.866 17.84 0.999 282329.05 261776.78 219427.42 177078.06 134728.71 106495.81 70582.27 42349.36
TA20 2159808.09 117.094 2.78 0.024 51835.39 46462.20 38686.89 30911.58 23136.27 17952.73 11291.88 6941.82
TA21 1879680.39 95.112 22.17 0.233 437965.53 401718.39 336023.56 270328.74 204633.91 160837.35 102713.03 62305.65
TA22 1853621.93 93.611 15.94 0.170 315115.73 280956.78 233689.42 186422.06 139154.70 107643.13 69674.88 42715.33
TA24 3715605.73 270.566 11.38 0.042 156055.44 137991.44 114583.12 91174.81 67766.49 52160.94 33625.21 20713.99
TA3 2697932.22 168.419 2.53 0.015 40468.98 36520.47 30450.12 24379.78 18309.43 14262.53 9161.22 5592.34
TA4 4151861.21 254.604 2.65 0.010 41518.61 37824.49 31596.70 25368.91 19141.11 14989.25 9577.44 5826.69
TQ1 24333.43 2.753 2.75 0.999 24309.10 23093.64 19447.27 15800.91 12154.55 9723.64 6077.28 3646.36
TQ10 545741.00 47.003 47.00 1.000 545741.00 507933.39 426072.24 344211.09 262349.94 207775.84 131083.17 79185.11
TQ11 581560.02 34.794 34.79 1.000 581560.02 513472.29 426238.28 339004.28 251770.28 193614.28 123251.22 76164.61
TQ12 1454953.63 88.361 88.36 1.000 1454953.63 1333341.00 1115097.95 896854.91 678611.86 533116.50 344689.98 208718.83
TQ13 4300642.09 215.097 215.10 1.000 4300642.09 3904209.96 3259113.65 2614017.33 1968921.02 1538856.81 981892.72 598462.41
TQ14 153885.26 14.373 14.37 1.000 153885.26 144263.38 121180.59 98097.80 75015.01 59626.49 38471.32 23082.79
TQ2 24192.13 3.600 3.60 1.000 24192.13 22982.52 19353.70 15724.88 12096.07 9676.85 6048.03 3628.82
TQ3 216742.76 13.730 13.73 1.000 216742.76 192997.73 160486.32 127974.90 95463.49 73789.21 48255.77 29546.46
TQ4 97776.17 5.554 5.55 0.999 97678.39 89236.69 74584.93 59933.18 45281.41 35513.57 24419.60 14651.76
TQ5 139481.84 13.081 13.08 1.000 139481.84 122072.40 101150.13 80227.85 59305.57 45357.39 28992.11 17983.10
TQ6 688740.03 41.146 41.11 0.999 688051.29 610774.24 507566.56 404358.86 301151.17 232346.04 147406.32 90904.44
TQ7 2985679.51 171.840 171.72 0.999 2982693.83 2665216.50 2217812.42 1770408.34 1323004.27 1024734.89 662409.76 405772.22
TQ8 150169.89 10.353 10.32 0.997 149719.38 132128.27 109670.36 87212.46 64754.55 49782.61 32141.94 19813.96
TQ9 3454545.04 179.338 179.34 1.000 3454545.04 3106311.45 2588129.69 2069947.94 1551766.18 1206311.68 766868.52 469797.88

Table 1.3 P1 reductions by postcode district - Dorset
PC 2020_Unadjusted Agri_In Agri_Out Agri_PC 2020 2021 2022 2023 2024 2025 2026 2027
BA12 6346310.03 295.497 0.66 0.002 12692.62 10276.15 8372.25 6468.36 4564.47 3295.21 2191.08 1412.86
BA21 237902.25 12.906 1.36 0.105 24979.74 23093.41 19346.45 15599.49 11852.53 9354.56 6244.93 3746.96
BA22 2812398.19 175.078 17.10 0.098 275615.02 247215.89 205873.64 164531.38 123189.13 95627.63 61442.81 37611.78
BA8 652094.50 38.458 1.62 0.042 27387.97 24637.10 20528.91 16420.71 12312.52 9573.72 6188.86 3779.13
BA9 1238362.79 67.125 0.68 0.010 12383.63 11033.29 9175.75 7318.20 5460.66 4222.30 2819.53 1719.36
BH10 18441.91 1.309 1.31 1.001 18460.35 17537.33 14768.28 11999.23 9230.18 7384.14 4615.09 2769.06
BH15 1397.27 0.051 0.05 0.980 1369.32 1300.86 1095.46 890.07 684.67 547.73 342.33 205.40
BH16 214147.37 21.405 21.41 1.000 214147.37 199302.94 167180.84 135058.73 102936.63 81521.89 53536.84 32122.11
BH17 53650.86 0.705 0.70 0.993 53275.30 48287.61 40296.33 32305.03 24313.73 18986.20 13318.83 7991.30
BH19 490262.12 28.404 28.37 0.999 489771.86 415393.98 341928.20 268462.42 194996.64 146019.45 90390.74 57439.66
BH20 3190961.34 145.911 145.86 1.000 3190961.34 2643555.09 2164910.89 1686266.69 1207622.49 888526.36 602366.94 380957.51
BH21 2516506.61 180.032 178.09 0.989 2488825.04 2070484.58 1697160.83 1323837.08 950513.32 701630.82 465576.90 295009.08
BH22 56651.95 6.375 6.38 1.001 56708.60 53873.17 45366.88 36860.59 28354.31 22683.44 14177.15 8506.29
BH23 600654.08 41.168 15.93 0.387 232453.13 195136.11 160268.14 125400.17 90532.20 67286.89 41478.33 26550.49
BH24 861956.35 46.934 7.29 0.155 133603.23 117635.33 97594.84 77554.36 57513.87 44153.55 28779.34 17729.75
BH25 250154.12 11.312 0.00 0.000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
BH31 16081.54 3.649 3.65 1.000 16081.54 15277.46 12865.23 10453.00 8040.77 6432.62 4020.39 2412.23
BH7 155716.17 0.168 0.17 1.012 157584.76 118188.58 94550.86 70913.15 47275.43 31516.95 23637.72 15758.48
BH8 40754.19 2.719 2.72 1.000 40754.19 36809.82 30696.69 24583.57 18470.44 14395.02 10188.55 6113.13
BH9 7150.73 1.055 1.05 0.995 7114.98 6759.22 5691.98 4624.73 3557.48 2845.99 1778.74 1067.25
DT1 321142.12 4.796 4.80 1.001 321463.26 260143.16 211923.67 163704.18 115484.69 83338.37 55307.14 35690.15
DT10 2215501.44 112.858 112.17 0.994 2202208.43 1965869.25 1635537.99 1305206.72 974875.46 754654.61 487547.94 298829.18
DT11 5268228.17 292.039 292.04 1.000 5268228.17 4387406.27 3597172.04 2806937.82 2016703.59 1489880.77 958786.31 611098.86
DT2 11058244.50 541.513 541.39 1.000 11058244.50 9217476.53 7558739.86 5900003.18 4241266.51 3135442.06 2049903.67 1301407.95
DT3 772281.56 83.856 83.86 1.000 772281.56 700608.06 584765.83 468923.59 353081.36 275853.20 178561.59 108587.83
DT4 98837.48 2.798 2.80 1.001 98936.32 82183.82 67343.38 52502.93 37662.47 27768.85 16863.63 10905.22
DT5 6850.52 4.455 4.44 0.997 6829.97 6488.47 5463.98 4439.48 3414.98 2731.99 1707.49 1024.50
DT6 3036994.48 158.966 158.59 0.998 3030920.49 2685929.95 2231291.88 1776653.80 1322015.73 1018923.68 645108.70 398327.36
DT7 238968.44 16.753 1.44 0.086 20551.29 18088.45 15005.76 11923.06 8840.37 6785.24 4303.94 2665.75
DT8 1105528.16 75.156 74.20 0.987 1091156.29 1001781.97 838108.53 674435.09 510761.64 401646.02 258597.52 156577.67
DT9 3850902.00 175.569 146.50 0.834 3211652.27 2788947.75 2307199.91 1825452.07 1343704.23 1022539.00 664634.44 412608.53
EX13 2276377.07 111.911 3.44 0.031 70567.69 65156.28 54571.12 43985.97 33400.82 26344.05 16846.63 10187.51
SP5 6376124.67 337.513 44.94 0.133 848024.58 694610.34 567406.65 440202.96 312999.27 228196.82 148540.76 95470.99
SP6 2077494.82 103.099 9.11 0.088 182819.54 153505.47 126082.54 98659.61 71236.68 52954.72 34962.62 22051.80
SP7 1987764.70 116.721 64.70 0.554 1101221.64 988172.61 822989.36 657806.12 492622.87 382500.71 246788.04 150924.56
SP8 1209961.34 73.093 70.14 0.960 1161562.89 1082177.87 907943.43 733709.00 559474.57 443318.28 284630.27 171354.20
TA18 1030727.57 51.620 4.59 0.089 91734.75 80285.49 66525.28 52765.07 39004.85 29831.38 19711.00 12148.87
TA20 2159808.09 117.094 19.12 0.163 352048.72 315555.75 262748.44 209941.13 157133.82 121928.95 76690.67 47146.55

Table 1.4 P1 reductions by postcode district - Somerset
PC 2020_Unadjusted Agri_In Agri_Out Agri_PC 2020 2021 2022 2023 2024 2025 2026 2027
BA1 1317599.99 42.662 35.80 0.839 1105466.39 936981.26 771161.30 605341.34 439521.38 328974.75 214309.49 134791.41
BA10 783558.26 43.613 43.51 0.998 781991.14 692668.34 575369.66 458070.99 340772.32 262573.21 165622.85 102361.20
BA11 2127620.07 115.923 114.02 0.984 2093578.15 1865741.39 1551704.67 1237667.95 923631.23 714273.41 455995.13 280337.02
BA12 6346310.03 295.497 1.15 0.004 25385.24 20552.30 16744.51 12936.72 9128.94 6590.41 4382.16 2825.71
BA13 820881.86 63.448 0.81 0.013 10671.46 9237.62 7636.90 6036.18 4435.46 3368.32 2145.41 1339.49
BA14 1248966.35 65.935 0.74 0.011 13738.63 12072.86 10012.06 7951.27 5890.47 4516.61 2843.26 1765.09
BA15 574707.38 31.390 0.72 0.023 13218.27 11398.54 9415.80 7433.06 5450.32 4128.49 2556.94 1608.93
BA16 372739.20 20.284 20.28 1.000 372739.20 344620.29 288709.41 232798.53 176887.65 139613.73 88154.60 53395.78
BA2 1931256.06 120.317 117.18 0.974 1881043.40 1651047.58 1368891.08 1086734.57 804578.06 616473.71 391000.13 242526.16
BA20 64409.18 2.669 2.67 1.000 64409.18 61188.72 51527.34 41865.97 32204.59 25763.67 16102.30 9661.38
BA21 237902.25 12.906 11.55 0.895 212922.51 196843.86 164905.48 132967.10 101028.73 79736.47 53230.63 31938.38
BA22 2812398.19 175.078 157.98 0.902 2536783.17 2275395.23 1894877.75 1514360.29 1133842.81 880164.49 565524.61 346181.89
BA3 3760736.13 112.129 112.13 1.000 3760736.13 3362431.13 2798320.71 2234210.29 1670099.87 1294026.26 821976.70 505006.75
BA4 2751068.31 146.960 146.96 1.000 2751068.31 2415479.97 2002819.72 1590159.47 1177499.23 902392.40 586463.86 362008.64
BA5 1690939.49 115.837 115.84 1.000 1690939.49 1528378.10 1274737.17 1021096.25 767455.33 598361.38 382991.34 233769.16
BA6 1390647.45 76.215 76.22 1.000 1390647.45 1240386.27 1031789.15 823192.03 614594.91 475530.17 301497.93 185515.15
BA7 379069.44 24.908 24.91 1.000 379069.44 340820.01 283959.60 227099.18 170238.76 132331.82 87658.99 53306.23
BA8 652094.50 38.458 36.84 0.958 624706.53 561960.63 468254.65 374548.67 280842.69 218372.04 141165.04 86200.19
BA9 1238362.79 67.125 66.40 0.989 1224740.80 1091192.70 907481.58 723770.45 540059.34 417585.26 278851.66 170044.35
BS13 10404.83 2.755 1.88 0.682 7096.09 6741.29 5676.87 4612.46 3548.05 2838.44 1774.03 1064.41
BS14 81151.54 6.419 6.11 0.952 77256.27 73393.45 61805.01 50216.57 38628.13 30902.51 19314.06 11588.44
BS15 10534.54 1.762 0.22 0.125 1316.82 1250.98 1053.45 855.93 658.41 526.73 329.20 197.52
BS20 199815.22 17.663 17.66 1.000 199815.22 188009.81 158037.52 128065.24 98092.96 78111.44 49953.80 29972.28
BS21 548234.79 31.763 31.76 1.000 548234.79 505671.30 423436.08 341200.86 258965.64 204142.16 130747.15 79079.45
BS22 179628.40 14.406 14.41 1.000 179628.40 170646.98 143702.72 116758.46 89814.20 71851.36 44907.10 26944.26
BS23 2872.94 2.148 2.15 1.001 2875.81 2732.02 2300.65 1869.28 1437.91 1150.33 718.96 431.37
BS24 773092.66 46.867 46.87 1.000 773092.66 698733.71 582769.81 466805.91 350842.01 273532.74 173936.27 106295.45
BS25 262358.33 19.462 19.46 1.000 262358.33 247070.08 207716.33 168362.58 129008.83 102772.99 65589.58 39353.75
BS26 654617.58 42.396 42.40 1.000 654617.58 614658.27 516465.63 418273.00 320080.36 254618.60 163654.39 98192.64
BS27 315526.19 23.393 23.39 1.000 315526.19 298153.06 250824.14 203495.21 156166.28 124613.66 78881.55 47328.93
BS28 818646.31 45.860 45.86 1.000 818646.31 758089.58 635292.64 512495.69 389698.74 307834.11 198527.79 119730.05
BS29 136999.89 10.349 10.35 1.000 136999.89 130149.90 109599.91 89049.93 68499.94 54799.96 34249.97 20549.98
BS3 60737.92 1.009 0.47 0.466 28303.87 22730.02 18484.44 14238.86 9993.28 7162.89 4303.53 2859.36
BS30 318622.86 32.179 0.87 0.027 8602.82 8172.68 6882.25 5591.83 4301.41 3441.13 2150.70 1290.42
BS31 277742.52 17.951 17.10 0.953 264688.62 238610.11 198906.82 159203.53 119500.23 93031.37 59187.89 36211.16
BS39 804731.30 65.493 65.49 1.000 804731.30 711470.72 590761.02 470051.33 349341.63 268868.50 175814.25 108025.41
BS4 7065.85 0.694 0.02 0.029 204.91 194.66 163.93 133.19 102.45 81.96 51.23 30.74
BS40 1926969.72 123.740 123.74 1.000 1926969.72 1718103.55 1429058.09 1140012.63 850967.17 658270.20 425627.94 260988.21
BS41 302196.87 12.967 12.82 0.989 298872.70 268659.52 223828.61 178997.71 134166.80 104279.53 69751.93 42347.78
BS48 662720.47 39.377 39.38 1.000 662720.47 619520.94 520112.87 420704.80 321296.73 255024.68 165680.12 99408.07
BS49 445168.44 20.350 20.35 1.000 445168.44 414162.57 347387.30 280612.03 213836.77 169319.92 105460.48 63859.45
BS8 282824.38 11.121 11.12 1.000 282824.38 264712.79 222289.13 179865.47 137441.82 109159.38 70706.10 42423.66
BS9 14657.62 0.409 0.38 0.929 13616.93 12936.08 10893.55 8851.00 6808.46 5446.77 3404.23 2042.54
DT10 2215501.44 112.858 0.69 0.006 13293.01 11866.41 9872.46 7878.51 5884.56 4555.26 2942.95 1803.80
DT2 11058244.50 541.513 0.10 0.000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
DT8 1105528.16 75.156 0.95 0.013 14371.87 13194.70 11038.92 8883.14 6727.36 5290.17 3406.05 2062.32
DT9 3850902.00 175.569 29.07 0.166 639249.73 555114.30 459226.84 363339.38 267451.92 203526.95 132289.35 82125.92
EX13 2276377.07 111.911 1.04 0.009 20487.39 18916.34 15843.23 12770.12 9697.01 7648.27 4890.96 2957.66
EX14 3584346.54 186.890 0.76 0.004 14337.39 13205.98 11055.37 8904.76 6754.16 5320.42 3379.78 2048.33
EX15 3044385.84 167.143 1.10 0.007 21310.70 19928.31 16731.70 13535.10 10338.49 8207.42 5288.73 3177.13
EX16 6005179.21 325.694 2.74 0.008 48041.43 44748.48 37542.27 30336.05 23129.84 18325.69 11639.92 7021.00
EX35 653966.01 54.251 8.38 0.154 100710.77 88470.69 73364.08 58257.46 43150.85 33079.77 20787.05 12911.29
EX36 4654512.01 226.749 9.90 0.044 204798.53 185175.58 154455.80 123736.02 93016.24 72536.39 46353.21 28296.57
SN13 864110.22 39.210 0.18 0.005 4320.55 3828.63 3180.55 2532.47 1884.38 1452.33 970.20 593.12
SN14 2795932.20 167.304 0.02 0.000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
SP8 1209961.34 73.093 2.33 0.032 38718.76 36072.60 30264.78 24456.97 18649.15 14777.28 9487.68 5711.81
TA1 583543.77 3.439 3.44 1.000 583543.77 463194.84 375663.28 288131.71 200600.15 142245.77 97741.11 63459.15
TA10 2109692.92 99.423 99.42 1.000 2109692.92 1925927.87 1609473.93 1293019.99 976566.05 765596.76 495036.55 300260.60
TA11 1073232.78 75.066 75.07 1.000 1073232.78 967715.24 806730.32 645745.41 484760.49 377437.21 240518.34 147089.99
TA12 558660.27 27.257 27.26 1.000 558660.27 506390.68 422591.64 338792.60 254993.56 199127.54 127181.38 77557.20
TA13 460559.01 21.453 21.45 1.000 460559.01 412193.56 343109.71 274025.86 204942.00 158886.10 101043.32 62035.64
TA14 177904.61 10.714 10.71 1.000 177904.61 157532.63 130846.94 104161.25 77475.56 59685.10 38461.99 23678.61
TA15 29031.53 3.646 3.65 1.001 29060.56 27607.53 23248.45 18889.36 14530.29 11624.22 7265.14 4359.08
TA16 86162.14 4.651 4.65 1.000 86162.14 81854.03 68929.71 56005.39 43081.07 34464.86 21540.54 12924.32
TA17 178279.32 13.211 13.21 1.000 178279.32 147100.00 120358.11 93616.21 66874.31 49046.38 29726.26 19320.11
TA18 1030727.57 51.620 47.03 0.911 938992.82 821798.70 680949.78 540100.85 399251.93 305352.65 201760.92 124355.28
TA19 1411625.94 72.381 72.38 1.000 1411625.94 1240763.41 1029019.52 817275.63 605531.74 464369.14 301098.96 185840.13
TA2 818663.67 38.814 38.81 1.000 818663.67 731050.62 608251.07 485451.52 362651.97 280785.60 184573.91 112753.55
TA20 2159808.09 117.094 95.20 0.813 1755923.98 1573906.89 1310518.29 1047129.69 783741.10 608148.70 382512.35 235154.27
TA21 1879680.39 95.112 72.94 0.767 1441714.86 1322394.89 1106137.66 889880.43 673623.20 529451.72 338115.44 205100.59
TA22 1853621.93 93.611 77.68 0.830 1538506.20 1371730.15 1140954.22 910178.29 679402.36 525551.74 340177.36 208551.34
TA23 740420.68 48.578 48.58 1.000 740420.68 682778.47 571715.37 460652.27 349589.16 275547.10 177352.78 107186.91
TA24 3715605.73 270.566 259.18 0.958 3559550.29 3147518.98 2613586.44 2079653.89 1545721.35 1189766.32 766974.92 472476.22
TA3 2697932.22 168.419 165.89 0.985 2657463.24 2398177.56 1999558.08 1600938.59 1202319.10 936572.78 601587.10 367230.12
TA4 4151861.21 254.604 251.95 0.990 4110342.60 3744624.40 3128073.01 2511521.62 1894970.24 1483935.97 948166.86 576841.99
TA5 2925401.70 146.607 146.61 1.000 2925401.70 2579174.07 2140363.81 1701553.56 1262743.30 970203.13 634622.56 390446.32
TA6 733241.99 29.051 29.05 1.000 733241.99 671836.35 561850.06 451863.76 341877.46 268553.26 172014.72 104338.41
TA7 2616149.68 165.078 165.08 1.000 2616149.68 2393421.48 2000999.03 1608576.58 1216154.13 954539.16 617416.55 374112.02
TA8 229119.70 10.372 10.34 0.997 228432.34 208333.83 174068.97 139804.13 105539.27 82696.04 51323.49 31372.55
TA9 1067636.38 65.504 65.50 1.000 1067636.38 1007790.37 847644.91 687499.45 527354.00 420590.36 266909.10 160145.46

2. Pillar 1: District-level

Calculation of P1 payment reductions at sub-county (district unitary authority) level. Uses same basic methodology as above, but the level of data management complexity is higher due to multiple area-within-area p1 reduction calculations.

#> Get district boundary data for SW counties
districts.sw <- st_read(here("In", "Shape", "Districts.SW.shp"), quiet = TRUE)
#> Convert Sw counties layer back to British National Grid
south.west <- st_transform(south.west, 27700)
#> Join districts with SW counties
districts.sw <- st_join(districts.sw, south.west, largest = TRUE) |> 
  filter(!is.na(NAME.y)) |> 
  select(NAME.x, NAME.y) |> 
  rename(NAME_DISTRICT = NAME.x, NAME_COUNTY = NAME.y) 

#? Remove string "(B)" from district names
# # districts.sw$NAME <- str_remove_all(districts.sw$NAME, "(B)")
districts.sw$NAME_DISTRICT <- gsub("\\s*\\([^\\)]+\\)", "", districts.sw$NAME_DISTRICT)
#> Trim WS
districts.sw$NAME_DISTRICT <- trimws(districts.sw$NAME_DISTRICT)
# head(districts.sw)

#> Create an empty data table to hold the P1 reductions for districts - will be populated in below loop
district.summary <- data.frame(Name=character(),
                                P1_2020=as.numeric(),
                                P1_2021=as.numeric(),
                                P1_2022=as.numeric(), 
                                P1_2023=as.numeric(), 
                                P1_2024=as.numeric(), 
                                P1_2025=as.numeric(), 
                                P1_2026=as.numeric(), 
                                P1_2027=as.numeric())
                         


#> Sequential integer counter (for figure numbers)
i <-0

#> Initiate for loop
for(active_county in counties){

#> Loop counter (for table caption number)
i <- i+1


#> Initiate for loop here
#> For county in counties
target_county <- counties.gb |>
  filter(NAME == active_county)
head(target_county)


# #> Get the first county (example here without a loop = Cornwall)
# #> For county in counties
# target_county <- counties.gb |>
#   filter(NAME == "Cornwall")


#> Clip districts.sw to extent of counties (do for one county initially - Cornwall)
districts.clip <- st_intersection(districts.sw, target_county) |> 
#> Get only the districts that are officially within the active county
  #> (During the st_join process some slightly overlapping districts from other counties may be joined
  filter(NAME_COUNTY == active_county)

head(active_county)
head(districts.clip)

#> NEED TO START ANOTHER FOR LOOP HERE TO LOOP THROUGH DISTRICTS WITHIN COUNTY
#> FOR NOW CHOOSE ISLES OF SCILLY WITHOUT FOR LOOP
districts <- as.list(districts.clip$NAME_DISTRICT)

#> Initiate districts loop
for(district in districts){

active_district <- districts.clip |> 
  filter(NAME_DISTRICT == district)
head(active_district)

#> Select postcode district areas that intersect with active district polygon
pcodes.int <- pcodes.gb[active_district,]
head(pcodes.int)
#> Add area (km2) column
pcodes.int$AreaM2 <- st_area(pcodes.int)
#> Convert from m2 to km2
pcodes.int$AREA_KM2_TOTAL <- pcodes.int$AreaM2 / 1000000
pcodes.int$AREA_KM2_TOTAL <- round(pcodes.int$AREA_KM2_TOTAL, digits = 3)
pcodes.int$AREA_KM2_TOTAL <- as.numeric(pcodes.int$AREA_KM2_TOTAL)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "pcodes.int.shp"))
unlink(here("Out", "Tests", "pcodes.int.dbf"))
unlink(here("Out", "Tests", "pcodes.int.prj"))
unlink(here("Out", "Tests", "pcodes.int.shx"))
st_write(pcodes.int, here("Out", "Tests", "pcodes.int.shp"), quiet = TRUE)


#> Generate a layer of clipped (cookie cutter) postcodes using active district boundary
pcodes.clip <- st_intersection(pcodes.int, active_district)
#> Add area (km2) column
pcodes.clip$AreaM2 <- st_area(pcodes.clip)
#> Convert from m2 to km2
pcodes.clip$AREA_KM2_CLIP<- pcodes.clip$AreaM2 / 1000000
pcodes.clip$AREA_KM2_CLIP <- round(pcodes.clip$AREA_KM2_CLIP, digits = 3)
pcodes.clip$AREA_KM2_CLIP <- as.numeric(pcodes.clip$AREA_KM2_CLIP)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "pcodes.clip.shp"))
unlink(here("Out", "Tests", "pcodes.clip.dbf"))
unlink(here("Out", "Tests", "pcodes.clip.prj"))
unlink(here("Out", "Tests", "pcodes.clip.shx"))
st_write(pcodes.clip, here("Out", "Tests", "pcodes.clip.shp"), quiet = TRUE)


#> To calculate agri land differences for postcodes which straddle the boundary of district...
#> 1. Intersect pcodes.int with corine.agri, to calculate area of agri land for all intersecting pcode district polys (whole polygon)
#> 2. Intersect pcodes.clip with corine.int to calculate area of agri land ony within target district polygon
#> 3. Calculate percentage difference between the TWO sets of area calculations to gove % of agri land in each pcode district polygon

#> 1. Intersect pcodes.int with corine.agri, to calculate area of agri land for all intersecting pcode district polys (whole polygon)
agri.int.total <- st_intersection(pcodes.int, corine.agri)
head(agri.int.total)
#> Calculate area of Corine agri land
agri.int.total$AREA_AGRI_TOTAL <- st_area(agri.int.total)
#> Convert from m2 to km2
agri.int.total$AREA_AGRI_TOTAL <- agri.int.total$AREA_AGRI_TOTAL / 1000000
agri.int.total$AREA_AGRI_TOTAL <- round(agri.int.total$AREA_AGRI_TOTAL, digits = 3)
agri.int.total$AREA_AGRI_TOTAL <- as.numeric(agri.int.total$AREA_AGRI_TOTAL)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "agri.int.total.shp"))
unlink(here("Out", "Tests", "agri.int.total.dbf"))
unlink(here("Out", "Tests", "agri.int.total.prj"))
unlink(here("Out", "Tests", "agri.int.total.shx"))
st_write(agri.int.total, here("Out", "Tests", "agri.int.total.shp"), quiet = TRUE)
#> Create grouped (by pcode) non-geo version of the table
st_geometry(agri.int.total) <- NULL
agri.int.total <- agri.int.total |> 
  select(name, AREA_AGRI_TOTAL) |> 
  group_by(name) |> 
  summarise(AGRI_TOTAL = sum(AREA_AGRI_TOTAL))
head(agri.int.total)



#> 2. Intersect pcodes.clip with corine.int to calculate area of agri land ony within target district polygon
agri.int.clip <- st_intersection(pcodes.clip, corine.agri)
#> Calculate area of Corine agri land
agri.int.clip$AREA_AGRI_CLIP <- st_area(agri.int.clip)
#> Convert from m2 to km2
agri.int.clip$AREA_AGRI_CLIP <- agri.int.clip$AREA_AGRI_CLIP / 1000000
agri.int.clip$AREA_AGRI_CLIP <- round(agri.int.clip$AREA_AGRI_CLIP, digits = 3)
agri.int.clip$AREA_AGRI_CLIP <- as.numeric(agri.int.clip$AREA_AGRI_CLIP)
#> Export data for detailed visual checking in QGIS
#> Remove existing shapefile
unlink(here("Out", "Tests", "agri.int.clip.shp"))
unlink(here("Out", "Tests", "agri.int.clip.dbf"))
unlink(here("Out", "Tests", "agri.int.clip.prj"))
unlink(here("Out", "Tests", "agri.int.clip.shx"))
st_write(agri.int.clip, here("Out", "Tests", "agri.int.clip.shp"), quiet = TRUE)
#> Create grouped (by pcode) non-geo version of the table
st_geometry(agri.int.clip) <- NULL
agri.int.clip <- agri.int.clip |> 
  select(name, AREA_AGRI_CLIP) |> 
  group_by(name) |> 
  summarise(AGRI_CLIP = sum(AREA_AGRI_CLIP))


#> 3. Calculate percentage difference between the two sets of area calculations to gove % of agri land in each pcode district polygon
#> Merge the two data frames to show size of agri area within and outside target county
agri.merge <- merge(agri.int.total, agri.int.clip, by = "name", all.x = TRUE)
#> Round area calcs up to 1 decimal place (to negate effect of small amounts of agri land being lost when clipped)
agri.merge$AGRI_TOTAL <- round(agri.merge$AGRI_TOTAL, digits = 3)
agri.merge$AGRI_CLIP <- round(agri.merge$AGRI_CLIP, digits = 2)
#> Calculate percentage of agri land within target county 
agri.merge$PCENT_AGRI_LAND <- agri.merge$AGRI_CLIP/ agri.merge$AGRI_TOTAL
#> Round up
agri.merge$PCENT_AGRI_LAND <- round(agri.merge$PCENT_AGRI_LAND, digits = 3)
head(agri.merge)


#> Extract postcode districts from the BPS source data ("db") which intersect with the active county polygon boundary
#> Do this via a merge between db and pcodes.int, keeping only matching records in a new data frame
#> Rename pcodes.in and drop geom
pcodes.active <- pcodes.int
st_geometry(pcodes.active) <- NULL
BPS.merge <- merge(db, pcodes.active, by.x = "PostcodePrefix_F202B", "name", all.x = FALSE)
#> Convert all NAs to zeros in data frame
BPS.merge[is.na(BPS.merge)] <- 0
head(BPS.merge)


#> BPS Calcs by year (for target district)

#> 2020
#> Create table with baseline P1 (BPS + Greening) payments by postcode district for 2020 (no reductions applied)
t1.2020 <- BPS.merge %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2020_Baseline = sum(`Basic payment scheme`) + sum(`Greening: practices beneficial for climate and environment`))
#> Check sum total of P1 for reference
sum.original.p1 <- sum(t1.2020$P1_2020_Baseline)
#> Merge with agri.merge data frame to append 2020 calcs and create new master table "t1"
t1 <- merge(t1.2020, agri.merge, by.x = "PostcodePrefix_F202B", by.y = "name")
#> #> Calculate P1 payment based on area of agri land within each postcode area
t1$P1_2020 <- t1$P1_2020_Baseline * t1$PCENT_AGRI_LAND
#> Round to 2 decimal places
t1$P1_2020 <- round(t1$P1_2020, digits = 2)




#> 2021
t1.2021 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2021$P1_2020 <- t1.2021$`Basic payment scheme` + t1.2021$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2021 reductions
t1.2021 <- t1.2021 %>% 
  mutate(P1_2021 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.95,
                              (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.90,
                              (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.80,
                              P1_2020 > 150000 ~ P1_2020 * 0.75))
# Group by postcode an summarise
t1.2021 <- t1.2021 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2021 = sum(P1_2021))
#> Round
t1.2021$P1_2021 <- round(t1.2021$P1_2021, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2021, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2021 <- t1$P1_2021 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2021 <- round(t1$P1_2021, digits = 2)
#> Check sum
sum.p1.2021 <- sum(t1$P1_2021)



#> 2022
t1.2022 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2022$P1_2020 <- t1.2022$`Basic payment scheme` + t1.2022$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2022 reductions
t1.2022 <- t1.2022 %>% 
   mutate(P1_2022 = case_when(P1_2020<=30000 ~ P1_2020* 0.80,
                             (P1_2020>30000 & P1_2020<=50000) ~ P1_2020* 0.75,
                             (P1_2020>50000 & P1_2020<=150000) ~ P1_2020* 0.65,
                             P1_2020> 150000 ~ P1_2020* 0.60))
# Group by postcode an summarise
t1.2022 <- t1.2022 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2022 = sum(P1_2022))
#> Round
t1.2022$P1_2022 <- round(t1.2022$P1_2022, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2022, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2022 <- t1$P1_2022 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2022 <- round(t1$P1_2022, digits = 2)
#> Check sum
sum.p1.2022 <- sum(t1$P1_2022)


#> 2023
t1.2023 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2023$P1_2020 <- t1.2023$`Basic payment scheme` + t1.2023$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2023 reductions
t1.2023 <- t1.2023 %>% 
  mutate(P1_2023 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.65,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.60,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.50,
                             P1_2020 > 150000 ~ P1_2020 * 0.45))
# Group by postcode an summarise
t1.2023 <- t1.2023 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2023 = sum(P1_2023))
#> Round
t1.2023$P1_2023 <- round(t1.2023$P1_2023, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2023, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2023 <- t1$P1_2023 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2023 <- round(t1$P1_2023, digits = 2)
#> Check sum
sum.p1.2023 <- sum(t1$P1_2023)


#> 2024
t1.2024 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2024$P1_2020 <- t1.2024$`Basic payment scheme` + t1.2024$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2024 reductions
t1.2024 <- t1.2024 %>% 
  mutate(P1_2024 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.50,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.45,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.35,
                             P1_2020 > 150000 ~ P1_2020 * 0.30))
# Group by postcode an summarise
t1.2024 <- t1.2024 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2024 = sum(P1_2024))
#> Round
t1.2024$P1_2024 <- round(t1.2024$P1_2024, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2024, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2024 <- t1$P1_2024 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2024 <- round(t1$P1_2024, digits = 2)
#> Check sum
sum.p1.2024 <- sum(t1$P1_2024)


#> 2025
t1.2025 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2025$P1_2020 <- t1.2025$`Basic payment scheme` + t1.2025$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2025 reductions
t1.2025 <- t1.2025 %>% 
 mutate(P1_2025 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.40,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.35,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.25,
                             P1_2020 > 150000 ~ P1_2020 * 0.20))
# Group by postcode an summarise
t1.2025 <- t1.2025 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2025 = sum(P1_2025))
#> Round
t1.2025$P1_2025 <- round(t1.2025$P1_2025, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2025, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2025 <- t1$P1_2025 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2025 <- round(t1$P1_2025, digits = 2)
#> Check sum
sum.p1.2025 <- sum(t1$P1_2025)


#> 2026
t1.2026 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2026$P1_2020 <- t1.2026$`Basic payment scheme` + t1.2026$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2026 reductions
t1.2026 <- t1.2026 %>% 
  mutate(P1_2026 = case_when(P1_2020 <=30000 ~ P1_2020 * 0.25,
                             (P1_2020 >30000 & P1_2020 <=50000) ~ P1_2020 * 0.25,
                             (P1_2020 >50000 & P1_2020 <=150000) ~ P1_2020 * 0.15,
                             P1_2020 > 150000 ~ P1_2020 * 0.15))
# Group by postcode an summarise
t1.2026 <- t1.2026 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2026 = sum(P1_2026))
#> Round
t1.2026$P1_2026 <- round(t1.2026$P1_2026, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2026, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2026 <- t1$P1_2026 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2026 <- round(t1$P1_2026, digits = 2)
#> Check sum
sum.p1.2026 <- sum(t1$P1_2026)


#> 2027
t1.2027 <- BPS.merge %>% 
  select(PostcodePrefix_F202B, `Basic payment scheme`, `Greening: practices beneficial for climate and environment`)
#> Column to hold total total P1 payments (i.e. BPS + Greening) - baseline for 2020
t1.2027$P1_2020 <- t1.2027$`Basic payment scheme` + t1.2027$`Greening: practices beneficial for climate and environment`
#> Add new column showing 2027 reductions
t1.2027 <- t1.2027 %>% 
   mutate(P1_2027 = case_when(P1_2020<=30000 ~ P1_2020* 0.15,
                             (P1_2020>30000 & P1_2020<=50000) ~ P1_2020* 0.15,
                             (P1_2020>50000 & P1_2020<=150000) ~ P1_2020* 0.10,
                             P1_2020> 150000 ~ P1_2020* 0.10))
# Group by postcode an summarise
t1.2027 <- t1.2027 %>% 
  group_by(PostcodePrefix_F202B) %>% 
  summarise(P1_2027 = sum(P1_2027))
#> Round
t1.2027$P1_2027 <- round(t1.2027$P1_2027, digits = 2)
# merge with main P1 results table (m.)
t1 <- merge(t1, t1.2027, by.x = "PostcodePrefix_F202B", by.y = "PostcodePrefix_F202B", all.x = TRUE)
# Change values according to agi land area proportion
t1$P1_2027 <- t1$P1_2027 * t1$PCENT_AGRI_LAND #> Round
t1$P1_2027 <- round(t1$P1_2027, digits = 2)
#> Check sum
sum.p1.2027 <- sum(t1$P1_2027)

#> Convert all NAs to zeros in data frame
t1[is.na(t1)] <- 0

#> Create a new data frame to hold P1 reduction values by year summed for each district
head(active_district)
district.summary <- district.summary |> 
  add_row(Name = district, 
          P1_2020 = sum(t1$P1_2020),
          P1_2021 = sum(t1$P1_2021),
          P1_2022 = sum(t1$P1_2022),
          P1_2023 = sum(t1$P1_2023),
          P1_2024 = sum(t1$P1_2024),
          P1_2025 = sum(t1$P1_2025),
          P1_2026 = sum(t1$P1_2026),
          P1_2027 = sum(t1$P1_2027))
head(district.summary)
#> Wipe t1 rows clean
t1 <- t1[0,]



#> Web plot

}



#> Print table district.summary on web page
print(knitr::kable(district.summary, caption = paste0("Table 2.", i , " ", "P1 reductions by district - ",  active_county)))

cat("\n")
cat("\n")
cat("\n")
cat("\n")
cat("\n")
cat("\n")

#> Create bar plots

#> Get a list of districts from the active district.summary table
districts.list <- as.list(district.summary$Name)

for (district.active in districts.list)

{

#> Create data table with only active row (district) from districts.summary table
df <- district.summary|> 
  filter(Name == district.active)
#> Shape data
p2.in <- as.data.frame(colSums(df[2:8]))
#> Change rownames to column "Value"
p2.plot <- tibble::rownames_to_column(p2.in, "VALUE")
#> Extract year from string
p2.plot$VALUE <- sub("^.*([0-9]{4}).*", "\\1", p2.plot$VALUE)
names(p2.plot)[1]<-paste("Year")
names(p2.plot)[2]<-paste("Value_bps")

# Simple bar chart
plot2 <- ggplot(p2.plot, aes(x=Year, y=Value_bps)) + 
  theme_bw() +
  geom_bar(stat = "identity", fill="#9e66ab", width = 0.6) +
  geom_text(aes(label= paste0(round(Value_bps / 1000000, digits = 2), " M")), vjust = 1.5, colour = "white") +
  labs(title = paste0("Pillar 1 reductions:", " ", district.active), x = "Year", y = "Value (£)") +
  theme(plot.title = element_text(hjust = 0.5)) +
  theme(axis.title.y = element_text(margin = margin(t = 0, r = 16, b = 0, l = 0))) +
  theme(axis.title.x = element_text(margin = margin(t = 12, r = 0, b = 0, l = 0))) +
  theme(legend.position="none") +
  scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))
plot2
print(plot2)


#> Export the plot
ggsave(here("Out", "P1", "District", "Plot", paste0("P1_Reductions_", district.active, ".png")))


}



#> Export table
write_csv(district.summary, here("Out", "P1", "District", "CSV", paste0("P1_Reductions_", active_county, ".csv")))



#> Wipe district.summary rows clean
district.summary <- district.summary[0,]


  
}
Table 2.1 P1 reductions by district - Cornwall
Name P1_2020 P1_2021 P1_2022 P1_2023 P1_2024 P1_2025 P1_2026 P1_2027
Cornwall 51383073.3 46354837.2 38647376 30939915.16 23232454.20 18094146.8 11591430.9 7080292.3
Isles of Scilly 142708.1 126897.2 105491 84084.82 62678.61 48407.8 29893.4 18514.4

Table 2.2 P1 reductions by district - Devon
Name P1_2020 P1_2021 P1_2022 P1_2023 P1_2024 P1_2025 P1_2026 P1_2027
Torbay 259094.9 233651.4 194787.16 155922.92 117058.70 91149.20 59967.08 36460.92
City of Plymouth 117098.2 106164.0 88599.29 71034.55 53469.83 41760.01 27255.58 16555.25
North Devon District 18022189.7 16359674.4 13656346.01 10953017.58 8249689.13 6447470.14 4132610.67 2516860.07
East Devon District 12969652.5 11718682.4 9773234.50 7827786.61 5882338.72 4585373.46 2937005.81 1792744.18
Teignbridge District 8220185.2 7453784.0 6220756.17 4987728.40 3754700.60 2932682.08 1879802.96 1145406.11
West Devon District 15175317.0 13664085.2 11387787.68 9111490.11 6835192.59 5317660.89 3389407.31 2074086.60
Mid Devon District 15649569.8 14335299.4 11987863.88 9640428.43 7292992.95 5728035.95 3656988.95 2219733.72
Exeter District 187590.0 172869.3 144730.80 116592.30 88453.80 69694.80 43963.44 26671.46
South Hams District 12681009.1 11347863.0 9445711.64 7543560.30 5641408.92 4373308.02 2810025.06 1722037.75
Torridge District 16060418.2 14712690.5 12303627.78 9894565.04 7485502.30 5879460.48 3767720.01 2285370.47

Table 2.3 P1 reductions by district - Dorset
Name P1_2020 P1_2021 P1_2022 P1_2023 P1_2024 P1_2025 P1_2026 P1_2027
Bournemouth, Christchurch and Poole 596872.4 496061.9 406531 317000.2 227469.3 167782.1 111831.9 70837.78
Dorset 37748668.6 32254953.5 26592653 20930352.9 15268052.6 11493185.8 7470987.5 4679210.46

Table 2.4 P1 reductions by district - Somerset
Name P1_2020 P1_2021 P1_2022 P1_2023 P1_2024 P1_2025 P1_2026 P1_2027
Bath and North East Somerset 4994784 4385886 3636668 2887451 2138233 1638755 1054001 651870.0
North Somerset 4351112 4003025 3350359 2697692 2045025 1609914 1031752 624653.7
Mendip District 12816685 11434350 9511848 7589345 5666842 4385174 2804817 1722825.8
Somerset West and Taunton District 16349676 14656391 12203940 9751488 7299037 5664069 3649807 2233645.2
South Somerset District 15589690 13956197 11617743 9279290 6940836 5381867 3469819 2124651.6
Sedgemoor District 8468006 7733514 6463313 5193112 3922911 3076111 1981845 1202622.5

To do

3. Agri-Environment

4. Agri land proportions calcs

Summary of Corine land cover types (all) by:

  • County level

  • District level

  • Agri land classification areas / maps

  • Summary ofAll CORINE types